VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsMsgID"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public Function GetMessageID() As String

Dim adoConn As ADODB.Connection
Dim RDMsgID As ADODB.Recordset
Dim SQL As String
Dim sLength As String
Dim nMsgId As String


On Error GoTo PROC_ERROR

Set adoConn = New ADODB.Connection
With adoConn
    .CursorLocation = adUseClient
    .ConnectionString = GetConnectionString() 'Johann (20090625): Centralised code for connection string added
    .Open
End With

SQL = "Select last_value from dir_sequences where seq_name = 'MESSAGE_ID'"

Set RDMsgID = New ADODB.Recordset
With RDMsgID
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
End With

RDMsgID.Open SQL, adoConn
nMsgId = RDMsgID.Fields("last_value").Value

nMsgId = nMsgId + 1

sLength = Len(nMsgId)
        
        Select Case sLength
            Case 0
                nNewMessageID = "KT000000"
            Case 1
                nNewMessageID = "KT00000" & nMsgId
            Case 2
                nNewMessageID = "KT0000" & nMsgId
            Case 3
                nNewMessageID = "KT000" & nMsgId
            Case 4
                nNewMessageID = "KT00" & nMsgId
            Case 5
                nNewMessageID = "KT0" & nMsgId
            Case 6
                nNewMessageID = "KT" & nMsgId
        End Select
        
GetMessageID = nNewMessageID

'Update dir_sequences with new message ID
SQL = "Update dir_sequences set last_value = " & nMsgId & " where seq_name = 'MESSAGE_ID'"

Set RDMsgID = New ADODB.Recordset
With RDMsgID
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
End With

RDMsgID.Open SQL, adoConn

'clean up
adoConn.Close
RDMsgID.Close
Set RDMsgID = Nothing


PROC_EXIT:
  Exit Function

PROC_ERROR:
  Err.Raise Err.Number, _
            "clsMsgID/GetMessageID", _
            Err.Description
            
Resume PROC_EXIT
  
End Function




